unit Scripts;

interface

uses Constants, ImpactSprite, Supply, Math, SysUtils, Recognition, AsphyreDef;

const
Numbers=['0','1','2','3','4','5','6','7','8','9'];

type
TMethInp = array of string;

TMethod = record
  Name:string;
  Col:byte;
  StrMethod:string;
end;

TScript=class
public
  Name:string;
  s:string;
  WaitStart:real;
  OneTime:boolean;
  Global:boolean;
  Used:boolean;
end;

const
StartOp='{';
EndOp='}';
StartInsMeth='(';
EndInsMeth=')';
InMethDec=',';
EndOfCalc=';';
Separators:set of char = [InMethDec];
MathSeparators:set of char = [StartOp,EndOp,InMethDec,StartInsMeth,
EndInsMeth,EndOfCalc,'[',']','=','/','+','*','-','^',':',' '];

procedure InitSystem;
function PrepareEvulation(code:string; vtype:string):string;
procedure ValueScritps(var Value:string);
procedure ExecuteScript(s:string);
procedure DivideScript(s:string);
procedure DoReserved(N,code:string;Inp:TMethInp);
function CheckCondition(s:string):boolean;
function InArray(s:string;A:array of string):integer;
function InVars(s:string):integer;
function IsLogical(s:string):boolean;
function FindEnd(s:string;s1,s2:string; StartC:integer):integer;
//function ExecuteMethod(MethName:string;V:array of string):boolean;
function GetNameEnd(s:string;checkstart,
  checkend:integer;withmath:boolean):integer;
function MakeInp(s:string):TMethInp;
function AddVar(s,VType,variant:string):string;
function PrepareMethod(s:string; numb:integer; MethInp:TMethInp):string;
function GetMethodReturn(AVar:TVariable;s:string):string;
procedure DoEnviromentVariables;
procedure DeleteVar(s:string);
function Script(Name,s:string;
  WaitStart:real;OneTime:boolean;Global:boolean):TScript;

var
Vars:array of TVariable;

implementation

uses Main, StrUtils, AsphyreSprite, TypInfo, Scenes;

var
StCount:integer;
DoExit:boolean;
SelfSprite:TNPC;
const
ReservedWords:array[0..3] of string =('if','while','for','method');
StandartCommands:array[0..11] of string =('createsprite','createexplosion',
  'createstatic','getcount','getcountinarea','setenemy','setenemyinarea',
  'getrandom','setselfparam','getselfparam','setself','self');

function Script(Name,s:string;WaitStart:real;OneTime:boolean;
  Global:boolean):TScript;
begin
  Result:=TScript.Create;
  Result.Name:=Name;
  Result.s:=s;
  Result.WaitStart:=WaitStart;
  Result.OneTime:=OneTime;
  Result.Global:=Global;
end;

function AddVar(s,VType,variant:string):string;
var
i:integer;
begin
  if InVars(s)>0 then
  exit;
  i:=Length(Vars);
  SetLength(Vars,i+1);
  Vars[i].Name:=s;
  Vars[i].VType:=VType;
  Vars[i].Variant:=Variant;
  if Variant='' then
  case VType[1] of
    'b':Vars[i].Variant:='false';
    'r':Vars[i].Variant:='0';
    'i':Vars[i].Variant:='0';
  end;
end;

procedure DeleteVar(s:string);
var
i,j,z:integer;
begin
  j:=InVars(s);
  if j>0 then
  begin
    z:=length(Vars);

    for i := j to z-1 do
    Vars[i]:=Vars[i+1];

    SetLength(Vars,z-1);
  end;
end;

function IsLogical(s:string):boolean;
var
i:integer;
begin
    Result:=not ((pos('true',s)=0)and(pos('false',s)=0)and(pos('==',s)=0)and(pos('!=',s)=0)and(pos(' and ',s)=0)
    and(pos(' or ',s)=0)and(pos(' xor ',s)=0));
    for i := 0 to Length(Vars)-1 do
    if pos('bool',Vars[i].VType)>0 then
    if Pos(Vars[i].Name,s)>0 then
    begin
      Result:=true;
      break;
    end;
end;

function InArray(s:string;A:array of string):integer;
var
i:integer;
begin
  result:=0;
  for i := 0 to length(A)-1 do
  if s=a[i] then
  begin
    result:=i+1;
    exit;
  end;
end;

function InVars(s:string):integer;
var
i:integer;
begin
  result:=0;
  for i := 0 to length(Vars)-1 do
  if s=Vars[i].Name then
  begin
    result:=i+1;
    exit;
  end;
end;

function FindEnd(s:string;s1,s2:string; StartC:integer):integer;
var
z:integer;
c:integer;
a:string;
begin
  c:=0;
  s:=Copy(s,StartC,Length(s)-StartC+1);
  z:=0;
  a:=s;
  repeat
    if (Pos(s1,s)<Pos(s2,s))and(Pos(s1,s)>0) then
    begin
      z:=z+pos(s1,s)+Length(s1)-1;

      Delete(s,1,pos(s1,s)+Length(s1)-1);

      inc(c);
    end
    else
    begin
      z:=z+pos(s2,s)+Length(s2)-1;

      Delete(s,1,pos(s2,s)+Length(s2)-1);

      dec(c);
    end;

    if Pos(s2,s)=0 then
    c:=0;
  until c=0;
  Result:=z+StartC-1;
end;

function GetNameEnd(s:string;checkstart,
  checkend:integer;withmath:boolean):integer;
var
i:integer;
begin
  for i := checkstart to checkend do
  if ((s[i] In MathSeparators) and withmath)or((s[i] In Separators) and
   not withmath) then
  begin
    Result:=i;
    exit;
  end;
  Result:=checkend+1;
end;

procedure ValueScritps(var Value:string);
begin
end;

function PrepareMethod(s:string; numb:integer; MethInp:TMethInp):string;
var
i,j:integer;
begin
  for j := 1 to Numb do
  while pos(' v'+IntToStr(j)+' ',s)>0 do
  begin
    i:=pos(' v'+IntToStr(j)+' ',s);
    Delete(s,i,length(' v'+IntToStr(j)+' '));
    Insert(MethInp[j-1],s,i);
  end;
  result:=s;
end;

function PrepareEvulation(code:string; vtype:string):string;
var
i,z:integer;
r:extended;
st:string;
begin
  if (vtype='real')or(vtype='int') then
  begin
    Preparation(code);
    for i := 0 to length(Vars)-1 do
    if ('real'=Vars[i].VType)or('int'=Vars[i].VType) then
    code:=ChangeVar(code,Vars[i].Name,StrTOFloat(Vars[i].Variant))
    else
    if Pos('method',Vars[i].VType)>0 then
    if Pos(Vars[i].Name,code)>0 then
    begin
      z:=Pos(Vars[i].Name,code);
      st:=Copy(code,z,FindEnd(code,StartInsMeth,EndInsMeth,z)-z+1)+';';
      st:=GetMethodReturn(Vars[i],st);
      Delete(code,z,FindEnd(code,StartInsMeth,EndInsMeth,z)-z+1);
      Insert(st,code,z);
    end;
    Recogn(code,r);
    if vtype='real' then
    Result:=FloatToStr(r)
    else
    if vtype='int' then
    Result:=IntToStr(round(r));
  end;
end;

function GetMethodReturn(AVar:TVariable;s:string):string;
var
i,st,en:integer;
Cond,vtype:string;
begin
  i:=StrToInt(Copy(AVar.VType,Pos('<',AVar.VType)+1,
  Pos('|',AVar.VType)-Pos('<',AVar.VType)-1));
  st:=length(AVar.Name)+2;
  en:=FindEnd(s,StartInsMeth,EndInsMeth,st-2);
  Cond:=Copy(s,st,en-st);
  vtype:=Copy(AVar.VType,Pos('|',AVar.VType)+1,
  Pos('>',AVar.VType)-Pos('|',AVar.VType)-1);
  AddVar('return',vtype,'');
  DivideScript(PrepareMethod(AVar.Variant,i,MakeInp(Cond)));
  Result:=Vars[InVars('return')-1].Variant;
  DeleteVar('return');
end;

function MakeInp(s:string):TMethInp;
var
i,j:integer;
begin
  i:=1;
  while length(s)>0 do
  begin
    SetLength(Result,i);
    j:=GetNameEnd(s,1,length(s),false);
    if (PosEx(StartInsMeth,s,j)>PosEx(EndInsMeth,s,j))or
     ((PosEx(StartInsMeth,s,j)=0)and(PosEx(EndInsMeth,s,j)>0))then
    j:=GetNameEnd(s,j+1,length(s),false);
    Result[i-1]:=Copy(s,1,j-1);
    Delete(s,1,j);
    inc(i);
  end;
end;

procedure DoReserved(N,code:string;Inp:TMethInp);
var
i:integer;
Flag:boolean;
begin
  if N='if' then
  if CheckCondition(Inp[0]) then
  begin
    DivideScript(code);
  end;
  if N='method' then
  begin
    AddVar(Inp[0],'method<'+Inp[1]+'|'+Inp[2]+'>',code);
  end;
  if N='for' then
  begin
    Flag:=false;
    if InVars(inp[0])=0 then
    begin
      AddVar(Inp[0],'int',inp[1]);
      Flag:=true;
    end;
    for i := StrToInt(Inp[1]) to StrToInt(Inp[2]) do
    begin
      Vars[InVars(Inp[0])-1].Variant:=IntToStr(i);
      DivideScript(code);
      DoEnviromentVariables;
    end;
    if Flag then
    DeleteVar(Inp[0]);
  end;
end;

procedure ExecuteScript(s:string);
var
MethInp:TMethInp;
c:integer;
Name:string;
st,en:integer;
Cond:string;
begin
  c:=GetNameEnd(s,1,length(s),true);
  Name:=copy(s,1,c-1);
  if InArray(Name,ReservedWords)>0 then
  begin
    if s[length(Name)+1]=StartInsMeth then
    begin
      st:=length(Name)+2;
      en:=FindEnd(s,StartInsMeth,EndInsMeth,st-1);
      Cond:=Copy(s,st,en-st);
      MethInp:=MakeInp(Cond);
      Delete(s,1,en+1);
      Delete(s,length(s),1);
      DoReserved(Name,s,MethInp);
    end;
  end
  else
  if InArray(Name,StandartCommands)>0 then
  begin
      st:=length(Name)+2;
      en:=FindEnd(s,StartInsMeth,EndInsMeth,st-1);
      Cond:=Copy(s,st,en-st);
      MethInp:=MakeInp(Cond);
      if Name='createsprite' then
      begin
        MethInp[1]:=PrepareEvulation(MethInp[1],'real');
        MethInp[2]:=PrepareEvulation(MethInp[2],'real');
        TNPC.Create(SpriteEngine,StrToFloat(MethInp[1]),
          StrToFloat(MethInp[2]),MethInp[0]);
      end
      else
      if Name='createstatic' then
      begin

      end
      else
      if Name='getcount' then
      begin
        with TGameScene(Scene) do
        Vars[InVars(MethInp[0])-1].Variant:=IntToStr(GetNamedCount(MethInp[1],
          BoneList));
      end
      else
      if Name='getrandom' then
      begin
        Vars[InVars(MethInp[0])-1].Variant:=FloatToStr(StrToFloat(MethInp[1])+
          random*(StrToFloat(MethInp[2])-StrToFloat(MethInp[1])));
      end
      else
      if Name='setself' then
      begin
        MethInp[0]:=PrepareEvulation(MethInp[1],'real');
        MethInp[1]:=PrepareEvulation(MethInp[2],'real');
        with TGameScene(Scene) do
        SelfSprite:=GetNPCAtPoint(Point2(StrToFloat(MethInp[0]),
          StrToFloat(MethInp[1])));
      end
      else
      if Name='self' then
      begin
      end;      
  end
  else
  begin
    c:=InVars(Name);
    if c>0 then
    begin
      if Pos('method<',Vars[c-1].VType)>0 then
      begin
        GetMethodReturn(Vars[c-1],s);
      end;
      if (Vars[c-1].VType='real')or(Vars[c-1].VType='int') then
      begin
        Vars[c-1].Variant:=PrepareEvulation(Copy(s,pos('=',s)+1,
          length(s)-pos('=',s)-1),Vars[c-1].VType);
      end;
      if (Vars[c-1].VType='bool')then
      begin
        Vars[c-1].Variant:=BoolToStr(CheckCondition(Copy(s,pos('=',s)+1,
          length(s)-pos('=',s)-1)),true);
      end;
    end;
  end;
end;

procedure DivideScript(s:string);
var
j,eoc,so:integer;
begin
  while (length(s)>0)or((eoc=so)and(eoc=maxint)) do
  begin
    eoc:=Pos(EndOfCalc,s);
    so:=Pos(StartOp,s);
    eoc:=IfThen(eoc=0,MaxInt,eoc);
    so:=IfThen(so=0,MaxInt,so);
    if eoc<so then
    begin
      ExecuteScript(Copy(s,1,eoc));
      Delete(s,1,eoc);
    end
    else
    if so<eoc then
    begin
      j:=FindEnd(s,StartOp,EndOp,0);
      ExecuteScript(Copy(s,1,j+1));
      Delete(s,1,j+1);
    end;
  end;
end;

function CheckCondition(s:string):boolean;
var
sb,eb:integer;
GVar:TVariable;
m,leftpart,rightpart:string;
begin
  if (pos('(',s)=0)or not IsLogical(s) then
  begin
    if (pos('=',s)=0)and(pos('>',s)=0)and(pos('<',s)=0)and(pos(' and ',s)=0)
    and(pos(' or ',s)=0)and(pos(' xor ',s)=0) then
    begin
      if (pos('true',s)=1)or(pos('false',s)=1) then
      begin
        Result:=StrToBool(s);
        exit;
      end;
      GVar:=Vars[InVars(Copy(s,1,GetNameEnd(s,1,length(s),true)))];
      if pos('method',GVar.VType)>0 then
      begin
        m:=GetMethodReturn(GVar,s);
        if m='false' then
        Result:=false
        else
        Result:=true;
      end
      else
      if pos('bool',GVar.VType)>0 then
      begin
        if GVar.Variant='false' then
        Result:=false
        else
        Result:=true;
      end;
    end
    else
    if (pos(' and ',s)>0)or(pos(' or ',s)>0)or(pos(' xor ',s)>0) then           
    begin
      if (pos(' and ',s)>0) then
      begin
        sb:=pos(' and ',s)-1;
        eb:=sb+6;
        m:='and';
      end
      else
      if (pos(' xor ',s)>0) then
      begin
        sb:=pos('xor',s)-1;
        eb:=sb+6;
        m:='xor';
      end
      else
      if (pos(' or ',s)>0) then
      begin
        sb:=pos('or',s)-1;
        eb:=sb+5;
        m:='or';
      end;
      if m='and' then
      Result:= CheckCondition(Copy(s,1,sb))and CheckCondition(Copy(s,eb,length(
        s)-eb+1))
      else
      if m='xor' then
      Result:= CheckCondition(Copy(s,1,sb))xor CheckCondition(Copy(s,eb,length(
        s)-eb+1))
      else
      if m='or' then
      Result:= CheckCondition(Copy(s,1,sb))or CheckCondition(Copy(s,eb,length(
        s)-eb+1));
    end
    else
    if (pos('==',s)>0) then
    begin
      sb:=pos('==',s)-1;
      eb:=sb+3;
      Result:= CheckCondition(Copy(s,1,sb))= CheckCondition(Copy(s,eb,length(
        s)-eb+1));
    end
    else
    if (pos('!=',s)>0) then
    begin
      sb:=pos('!=',s)-1;
      eb:=sb+3;
      Result:= CheckCondition(Copy(s,1,sb)) <> CheckCondition(Copy(s,eb,length(
        s)-eb+1));
    end
    else
    if (pos('>=',s)>0)or(pos('<=',s)>0) then
    begin
      if pos('>=',s)>0 then
      begin
        sb:=pos('>=',s)-1;
        eb:=sb+3;
        m:='>=';
      end
      else
      if pos('<=',s)>0 then
      begin
        sb:=pos('<=',s)-1;
        eb:=sb+3;
        m:='<=';
      end;
      leftpart:=Copy(s,1,sb);
      rightpart:=Copy(s,eb,length(s)-eb+1);
      leftpart:=PrepareEvulation(leftpart,'real');
      rightpart:=PrepareEvulation(rightpart,'real');
      if m='<=' then
      Result:=int(StrToFloat(leftpart))<=int(StrToFloat(rightpart))
      else
      Result:=int(StrToFloat(leftpart))>=int(StrToFloat(rightpart))
    end
    else
    if (pos('=',s)>0)or(pos('>',s)>0)or(pos('<',s)>0) then
    begin
      if pos('<',s)>0 then
      begin
        sb:=pos('<',s)-1;
        eb:=sb+2;
        m:='<';
      end
      else
      if pos('>',s)>0 then
      begin
        sb:=pos('>',s)-1;
        eb:=sb+2;
        m:='>';
      end
      else
      if pos('=',s)>0 then
      begin
        sb:=pos('=',s)-1;
        eb:=sb+2;
        m:='=';
      end;
      leftpart:=Copy(s,1,sb);
      rightpart:=Copy(s,eb,length(s)-eb+1);
      leftpart:=PrepareEvulation(leftpart,'real');
      rightpart:=PrepareEvulation(rightpart,'real');
      if m='=' then
      Result:=int(StrToFloat(leftpart))=int(StrToFloat(rightpart))
      else
      if m='>' then
      Result:=StrToFloat(leftpart)>StrToFloat(rightpart)
      else
      if m='<' then
      Result:=StrToFloat(leftpart)<StrToFloat(rightpart);
    end;
  end
  else
  begin

  end;
end;

procedure DoEnviromentVariables;
var
i:integer;
begin
  with TGameScene(Scene) do
  begin
    if Player<>nil then
    begin
      Vars[InVars('playerx')-1].Variant:=FloatToStr(Player.X);
      Vars[InVars('playery')-1].Variant:=FloatToStr(Player.Y);
      Vars[InVars('level')-1].Variant:=IntToStr(Player.Level);
    end;

    Vars[InVars('spritecount')-1].Variant:=IntToStr(SpriteEngine.Count);

    SetLength(BoneList,0);
    FillChar(BoneList,SizeOf(BoneCount),0);

    for i:=0 to SpriteEngine.Count-1 do
    if SpriteEngine[i] is TNPC then
    begin
      ChangeNamedCount(SpriteEngine[i].Name,1,BoneList);
    end;
  end;  
end;

procedure InitSystem;
begin
  AddVar('summ','method<2|int>','return:= v1 + v2 ;');
  AddVar('i','int','0');
  AddVar('playerx','real','');
  AddVar('playery','real','');
  AddVar('spritecount','int','');
  AddVar('level','int','');
  AddVar('count','method<1|int>','getcount(return, v1 );');
  AddVar('min','method<2|real>','if( v1 < v2 ){return:= v1 ;}if( v1 >=' +
    ' v2 ){return:= v2 ;}');
  AddVar('max','method<2|real>','if( v1 > v2 ){return:= v1 ;}if( v1 <=' +
    ' v2 ){return:= v2 ;}');
  AddVar('random','method<2|real>','getrandom(return, v1 , v2 );');
end;

initialization
InitSystem;

end.
